home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / Pocket Forth 0.6.3 / Source / Interface.txt < prev    next >
Encoding:
Text File  |  1993-07-04  |  17.2 KB  |  498 lines  |  [TEXT/McSk]
  1. tom of stack  ( 92 tib + )
  2. Form:        DC.L    $FFFF0007    ; decaform record  ( 96 tib + )
  3. Expand:        DC.L    0        ; hold address of expand routine  ( 100 tib + )
  4. FreePt:        DC.W    dictend-Base    ; initial compile point freespace  ( 104 tib + )
  5. FreeSz:        DC.W    base+32767-dictend    ; max headroom  ( 106 tib + )
  6. DictPt:        DC.W    task-theLink    ; initial dict. search start  ( 108 tib + )
  7. NBase:        DC.W    10        ; the numeric radix  ( 110 tib + )
  8. Held:        DC.W    0        ; the HLD data  ( 112 tib + )
  9. DoesAddr:    DC.L    0        ; "does>" jump address  ( 114 tib + )
  10. fcolon:        DC.B    0        ;   compile mode  ( 118 tib + )
  11. fimmed:        DC.B    0        ;   immediate flag  ( 119 tib + )
  12. fneg:        DC.B    0        ;   negative flag  ( 120 tib + )
  13. fint:        DC.B    $80        ;   interactive mode  ( 121 tib + )
  14. fmacro:        DC.W    0        ;   macro flag+filler  ( 122 tib + )
  15.  
  16.  
  17. ; ----- Startup Code -----
  18.  
  19. MacStart:    ; load the menus, setup a window and create a data block
  20.     MOVEQ    #1,D3
  21.     @0: CLR.L    -(SP)            ; room
  22.     MOVE    D3,-(SP)        ; Push menu ID
  23.     _GetRMenu            ; Get menu from resource.
  24.     MOVE    D3,D0
  25.     SUBQ    #1,D0
  26.     ASL    #2,D0
  27.     LEA     AppleMenu,A0        ; menu handle data area
  28.     MOVE.L    (SP),0(A0,D0.W)        ; Save it.
  29.     CLR    -(SP)            ; Push a 0 for append.
  30.     _InsertMenu
  31.     ADDQ    #1,D3
  32.     CMP    #4,D3
  33.     BNE.S    @0            ; do the next menu
  34.  
  35.     MOVE.L    AppleMenu,-(SP)
  36.     MOVE.L    #'DRVR',-(SP)        ; Load all DRVR resource types.
  37.     _AddResMenu            ; Add the DA's.
  38.     _DrawMenuBar
  39.  
  40.     ; create a window
  41.     CLR.L    -(SP)            ; make room for the new window pointer
  42.     MOVE    #128,-(SP)        ; WIND ID
  43.     CLR.L    -(SP)            ; put it on the heap
  44.     MOVE.L    #-1,-(SP)        ; behind none
  45.     MOVE.L    #'qd  ',-(PS)
  46.     JSR    qgestalt-base(BP)
  47.     TST    (PS)+
  48.     BEQ.S    @1
  49.     MOVE.L    (PS)+,D0
  50.     CMP    #$100,D0
  51.     BLT.S    @1
  52.     _GetNewCWindow
  53.     BRA.S    @2
  54.     @1:    _GetNewWindow
  55.     @2:    MOVE.L  (SP),theWindow-base(BP)
  56.     MOVE.L    (SP),-(SP)
  57.     MOVE.L    WSize-base(BP),-(SP)
  58.     CLR.W    -(SP)
  59.     _SizeWindow
  60.     MOVE.L    (SP),-(SP)
  61.     _ShowWindow
  62.     _SetPort
  63.     
  64.     ; create a temp scrap holder
  65.     MOVE.L    #10,D0            ; this is just a size
  66.     _NewHandle            ; create a handle
  67.     MOVE.L    A0,TextH-base(BP)    ; to hold clipboard data
  68.  
  69.     ; Check for multitasking environment
  70.     CLR    MFlag-base(BP)        ; set MFlag to 0
  71.     MOVE.W    #$A89F, D0        ; _Unimplemented
  72.     _GetTrapAddress            ; NGetTrapAddress
  73.     MOVE.L    A0,D1
  74.     MOVE.W    #$A860,D0        ; _WaitNextEvent
  75.     _GetTrapAddress            ; NGetTrapAddress
  76.     CMP.L    A0,D1
  77.     BEQ.S    @3            ; no multitasking
  78.     MOVE.W    #$100,MFlag-base(BP)    ; set multitasking flag
  79.  
  80.     ; install apple event handlers if running system 7
  81.     @3:    MOVE.L    #'evnt',-(PS)
  82.     JSR    QGestalt-base(BP)
  83.     TST    (PS)+            ; check for gestalt
  84.     BEQ.S    @5            ; no gestalt, just return
  85.     SUBQ.L    #1,(PS)+        ; check for apple events present
  86.     BNE.S    @5            ; no apple events, just return
  87.     MOVE    AEvents-base(BP),D0    ; start rel addr of the events list
  88.     @4:    LEA    0(BP,D0.W),A4        ; start addr of an item
  89.     CLR    -(A7)            ; result
  90.     MOVE.L    (A4),-(A7)        ; push event class
  91.     MOVE.L    4(A4),-(A7)        ; push event selector
  92.     MOVE    8(A4),D0        ; get rel addr of handler
  93.     PEA    0(BP,D0.W)        ; push abs addr of handler
  94.     PEA    (BP)            ; push refcon
  95.     CLR    -(A7)            ; not syshandler
  96.     _AEInstallEvent        ; INSTALL EACH EVENT IN THE LIST
  97.     TST    (A7)+            ; drop result
  98.     MOVE    10(A4),D0        ; get rel addr of next item
  99.     BNE.S    @4            ; a zero indicates done
  100.  
  101.     @5:    RTS
  102.  
  103.  
  104. ; ----- Event Loop ------
  105.  
  106. doDone:    MOVEA.L    intA7-base(BP),A7    ; *** quit PocketForth ***
  107.     RTS
  108.  
  109. doOpen:    CLR    openFlag-base(BP)
  110.     JMP    doload-base(BP)
  111.  
  112. NextEvent:
  113.     CLR    KFlag-base(BP)        ; clear the key flag
  114.     CLR    -(SP)            ; turn all menus white
  115.     _HiLiteMenu
  116.  
  117.     TST    doneFlag-base(BP)
  118.     BNE.S    dodone
  119.  
  120.      TST    openFlag-base(BP)
  121.      BNE.S    doopen
  122.  
  123.     MOVE    Runner-base(BP),D0
  124.     JSR    0(BP,D0.W)        ; run the idle routine
  125.  
  126.     clr.l    -(sp)
  127.     subq    #1,(sp)
  128.     PEA    EventRecord-base(BP)    ; event record to be filled
  129.  
  130.     TST    MFlag-base(BP)        ; running multitasking?
  131.     BNE.S    @1            ; if not, do SystemTask/GetNextEvent
  132.  
  133.     _SystemTask            ; handle DA's, etc.
  134.     _GetNextEvent            ; fill the event record
  135.     BRA.S    @2
  136.  
  137.     @1:    CLR.L    -(SP)            ; 0 sleep ticks
  138.     CLR.L    -(SP)            ; nil mouse region
  139.     _WaitNextEvent            ; get multitasking event
  140.  
  141.     @2:    TST    (SP)+            ; Is this an event?
  142.     BEQ.S    rdr            ;   no  this is a non-event
  143.  
  144.     MOVE    What-base(BP),D0    ; check the event number
  145.     CMPI    #23,D0            ; is it a HighLevelEvent?
  146.     BNE.S    @3
  147.     MOVEQ    #10,D0            ; remap HLEs to event 10 (IM VI5-12)
  148.  
  149.     @3:    LEA    Events-base(BP),A0
  150.   hop1:    ADD    D0,D0            ; Calculate and jump to the ...
  151.     MOVE    0(A0,D0.W),D0        ; ... rel addr of the routine ... 
  152.   hop2:    JMP    0(BP,D0.W)        ; ... in the Events list.
  153.  
  154. ; -- Mouse Down Event --
  155.  
  156. BDEvt:    CLR    -(SP)            ; Result of find window
  157.     MOVE.L    Where-base(BP),-(SP)    ; Mouse point of click.
  158.     PEA    WWindow-base(BP)    ; Var. for pointer of clicked wind.
  159.     _FindWindow            ; Returns window region code ...
  160.     CLR.L    D0            ; ... (see p. WM-27 in IM).
  161.     MOVE    (SP)+,D0        ; Pop part number
  162.     LEA    Clicks-base(BP),A0    ; clicks is an array of rel.addrs
  163.     BRA.S    hop1
  164.  
  165.     MenuBar:
  166.     CLR.L    -(SP)            ; Make room for menu choice data.
  167.     MOVE.L    Where-base(BP),-(SP)    ; Mouse coordinates of click.
  168.     _MenuSelect            ; Get the selected Menu data.
  169.     MOVE.L    (SP)+,-(PS)        ; menu ID and item to pstack.
  170.     bra.s    domenu
  171.         
  172.     DARgn:
  173.     PEA    EventRecord-base(BP)
  174.     MOVE.L    WWindow-base(BP),-(SP)
  175.     _SystemClick
  176.     RTS
  177.     
  178.     DragRgn:
  179.     MOVE.L    WWindow-base(BP),-(SP)    ; push The Window Pointer
  180.     MOVE.L    Where-base(BP),-(SP)    ; push The Mouse Coordinates
  181.     PEA    BigRect-base(BP)    ; The drag boundry limits
  182.     _DragWindow            ; Drag it
  183.    rdr:    RTS
  184.  
  185.     CloseRgn:
  186.     CLR    -(SP)
  187.     MOVE.L    WWindow-base(BP),-(SP)
  188.     MOVE.L    Where-base(BP),-(SP)
  189.     _TrackGoAway
  190.     MOVE    (SP)+,D0
  191.     BEQ.S    rdr
  192.     by:    MOVE    Closer-base(BP),D0    ; inital value: bye-base
  193.     BRA.S    hop2
  194.  
  195.     ContentRgn:                ; select the clicked in window.
  196.     MOVE.L    WWindow-base(BP),-(SP)
  197.     _SelectWindow
  198.     MOVE    Button-base(BP),D0    ; inital value: beep-base
  199.     BRA.S    hop2
  200.  
  201. ; -- Key Down Event --
  202.  
  203. KeyEvt:    _ObscureCursor
  204.     MOVE    Message+2-base(BP),D0
  205.     AND    #$FF,D0            ; D0 has the ASCII code of the key.
  206.     MOVE    Modify-base(BP),D1
  207.     BTST    #8,D1
  208.     BNE.S    CommandKey
  209.     MOVE    D0,kflag-base(BP)
  210.     @0:    RTS
  211.  
  212. ; Menu actions
  213.     CommandKey:                ; handle the menu choices.
  214.     CLR.L    -(SP)            ; Room for menu data.
  215.     MOVE    D0,-(SP)        ; Push ASCII.
  216.     _MenuKey            ; Get the menu data.
  217.     MOVE.L    (SP)+,-(PS)        ; menu ID and item to pstack.
  218.     DoMenu:    ; Determine which menu was used.
  219.     TST    2(PS)            ; is the item number = 0?
  220.     BEQ    twodrop            ; no menu selection, drop data
  221.     
  222.     CMPI    #1,(PS)            ; Is it the Apple menu? ...
  223.     BEQ.S    DoAppleMenu        ; handle this special case
  224.  
  225.     CMPI    #3,(PS)            ; Is it the Edit menu?
  226.     BNE.S    @0            ; the last special case *
  227.     CLR.L    -(SP)            ; Check if it's a DA window
  228.     _FrontWindow
  229.     MOVE.L    (SP)+,A0
  230.     TST    $6C(A0)            ; windowKind(FrontWindow)
  231.     BGE.S    @0            ; negative=dawindow
  232.  
  233.     TST    (PS)+            ; drop the menu id
  234.     CLR    -(SP)
  235.     MOVE    (PS)+,-(SP)        ; push item-1
  236.     SUBQ    #1,(SP)
  237.     _SysEdit            ; do the da edit stuff
  238.     TST    (SP)+
  239.     RTS
  240.  
  241.     @0:    MOVE    YourMenu-base(BP),D0    ; inital value:
  242.     LEA    0(BP,D0.W),A0        ; do a double indexed reference
  243.     MOVE    (PS)+,D0
  244.     SUBQ    #2,D0
  245.     ADD    D0,D0
  246.     MOVE    0(A0,D0.W),D0
  247.      LEA    0(BP,D0.W),A0
  248.     MOVE    (PS)+,D0
  249.     SUBQ    #1,D0
  250.     JMP    hop1-base(BP)
  251.  
  252. DoAppleMenu:
  253.     CLR    (PS)+
  254.     MOVE    (PS)+,D1
  255.     CMP    #1,D1            ; Is it the first item?
  256.     BNE.S    @0
  257.     MOVE    about-base(BP),D0
  258.     JMP    0(BP,D0.W)
  259.     @0:    PEA    WWindow            ; Its a DA
  260.     _GetPort
  261.     MOVE.L    AppleMenu-base(BP),-(SP)
  262.     MOVE    D1,-(SP)
  263.     PEA    (A2)            ; name at here
  264.     _GetItem
  265.     CLR    -(SP)
  266.     PEA    (A2)
  267.     _OpenDeskAcc
  268.     MOVE    (SP)+,D0
  269.     MOVE.L    WWindow-base(BP),-(SP)
  270.     _SetPort
  271.     RTS
  272.  
  273. DoAbout:
  274.     CLR    -(SP)            ; Room for which item number.
  275.     MOVE    #257,-(SP)        ; Resource ID of AboutDialog
  276.     CLR.L    -(SP)
  277.     _Alert                ; About Item
  278.     CLR    (SP)+            ; Don't care which item dismissed.
  279.     RTS
  280.  
  281. ; -- Update Event --
  282.  
  283. UDEvt:    PEA    WWindow-base(BP)
  284.     _GetPort
  285.     MOVE.L    WWindow-base(BP),-(SP)    ; push for _SetPort
  286.     MOVE.L    Message-base(BP),-(SP)    ; push wpointer for _EndUpdate
  287.     MOVE.L    (SP),-(SP)        ; push for _SetPort
  288.     MOVE.L    (SP),-(SP)        ; push for _BeginUpdate
  289.     _BeginUpdate            ; restrict to invalid region
  290.     _SetPort            ; specify this window
  291.     MOVE    Update-base(BP),D0    ; inital value: curs-base
  292.     JSR    0(BP,D0.W)        ; execute the draw routine
  293.     _EndUpdate            ; go back to current cliprgn
  294.     _SetPort
  295.     RTS
  296.  
  297. ; -- Activate Event --
  298.  
  299. ActEvt:    CLR    -(PS)            ; modify has on/off flag in bit 0
  300.     BTST    #0,Modify+1-base(BP)
  301.   act1:    BEQ.S    @0
  302.     SUBQ    #1,(PS)
  303.     @0:    MOVE    Activate-base(BP),D0    ; inital value: drop
  304.     JMP    0(BP,D0.W)
  305.  
  306. ; ---- Activate/Suspend ----
  307.  
  308. MFEvt:    CLR    -(PS)
  309.     TST    message-base(BP)
  310.     BMI    drop
  311.     BTST    #0,message+3-base(BP)
  312.     BRA.S    act1
  313.  
  314. ; ---- High Level Event ----
  315.  
  316. DoAEvent:
  317.     MOVEM.L    Dict/DP/IS/PS,saveAERegs-base(BP) ; send along PF's regs
  318.     CLR    -(SP)
  319.     PEA    eventRecord-base(BP)
  320.     _AEProcessAppleEvent
  321.     MOVE    (SP)+,-(PS)
  322.     BEQ.S    noaer
  323.     MOVE    AError-base(BP),D0
  324.     JMP    0(BP,D0.W)
  325.  noaer:    MOVEM.L    saveAERegs-base(BP),Dict/DP/IS/PS ; update PF's regs
  326.     RTS
  327.  
  328. aepre:    MOVEM.L    (SP)+,A0/A1/BP
  329.     MOVE.L    (SP)+,AEReply-base(BP)        ; store reply
  330.     MOVE.L    (SP)+,AEEventRecord-base(BP)    ; store event record
  331.     CLR    (SP)                ; return no error
  332.     MOVE.L    A1,-(SP)            ; re-stack the return addr
  333.     MOVEM.L    Dict/DP/IS/PS,-(SP)        ; stash the system regs
  334.     MOVEM.L    saveAERegs-base(BP),Dict/DP/IS/PS  ; load PF regs
  335.     JMP    (A0)
  336.  
  337. aenull:    BSR.S    aepre
  338.   aert:    BSR.S    aepost
  339.     RTS
  340.  
  341. aebye:    BSR.S    aepre
  342.     JSR    by-base(BP)
  343.     BRA.S    aert
  344.  
  345. aeopen:    BSR.S    aepre
  346.     BSR.S    aeopn
  347.     BRA.S    aert
  348.  
  349. aepost:    MOVE.L    (SP)+,A0
  350.     MOVEM.L    Dict/DP/IS/PS,saveAERegs-base(BP)  ; save PF regs
  351.     MOVEM.L    (SP)+,Dict/DP/IS/PS    ; restore the system regs
  352.     JMP    (A0)
  353.  
  354. aeopn:    CLR    -(SP)
  355.     MOVE.L    AEEventRecord-base(BP),-(SP)
  356.     MOVE.L    #'----',-(SP)
  357.     MOVE.L    #'list',-(SP)
  358.     PEA    desc-base(BP)
  359.     _AEGetParamDesc
  360.     TST    (SP)+
  361.     BNE.S    @0
  362.     MOVE    runner-base(bp),oldidle-base(BP)
  363.     MOVE    #odocidle-base,runner-base(BP)
  364.     @0:    RTS
  365.  
  366. OdocIdle:    ; Open the document in the idle handler
  367.     MOVE    oldIdle-base(bp),runner-base(BP)    ; reset old handler
  368.     CLR    -(SP)
  369.     PEA    desc-base(BP)
  370.     CLR.L    -(SP)
  371.     ADDQ.L    #1,(SP)            ; index = 1
  372.     MOVE.L    #'fss ',-(SP)        ; desired type
  373.     PEA    108(A2)            ; keyword
  374.     PEA    112(A2)            ; desc type
  375.     PEA    34(A2)            ; data pointer
  376.     MOVE.L    #70,-(SP)
  377.     PEA    104(A2)
  378.     _AEGetNthPtr            ; Get fssPtr at here + 34
  379.     TST    (SP)+            ; test for error
  380.     BNE.S    @1
  381.  
  382.     ; clear out a buffer for working directory param. block
  383.     LEA    40+64+80(A2),A0
  384.     MOVE    #19,D0
  385.     @0:    CLR.L    -(A0)
  386.     DBRA    D0,@0
  387.  
  388.     ; calc working directory here
  389.     MOVE    34(A2),22(A0)        ; -> ioVRefNum
  390.     MOVE.L    36(A2),48(A0)        ; -> ioWDDirID
  391.     _OpenWD
  392.     MOVE    22(A0),-(PS)        ; <- working directory
  393.  
  394.     ADDQ    #1,openFlag-base(BP)
  395.  
  396.     @1:    CLR    -(SP)            ; Be neat
  397.     PEA    desc-base(BP)
  398.     _AEDisposeDesc
  399.     ADDQ.L    #2,SP
  400.     RTS
  401.  
  402. ; Pasting support
  403.  
  404. ClearTermBuf:
  405.     MOVEQ    #76,D0
  406.     LEA    TermBuf-base(BP),IS
  407.     @0:    MOVE.L    #$20202020,0(IS,D0)    ; fill line buffer with blanks
  408.     SUBQ.B    #4,D0
  409.     BGE.S    @0
  410.     RTS
  411.  
  412. EmptyFS: ; clear pending loads from the file stack
  413.     TST    fsptr-base(BP)
  414.     BMI.S    @1
  415.     LEA    fstack-base(BP),A1
  416.     MOVE    fsptr-base(BP),D0
  417.     MOVE.L    0(A1,D0.W),A0        ; A0 has the next load block addr
  418.     MOVE.L    A0,D1
  419.     BEQ.S    @0            ; dont try to dispose of nil handle
  420.     CLR.L    0(A1,D0.W)
  421.     CMPA.L    TextH-base(BP),A0
  422.     BEQ.S    @0
  423.     _DisposHandle
  424.     @0:    SUBQ    #4,fsptr-base(BP)
  425.     BRA.S    emptyfs
  426.     @1:    RTS
  427.  
  428. Paste:    JSR    nocurs-base(BP)
  429.     CLR.L    -(SP)
  430.     MOVE.L    TextH-base(BP),-(SP)    ; handle to the scrap data
  431.     MOVE.L    #'TEXT',-(SP)
  432.     PEA    TextO-Base(BP)
  433.     _GetScrap
  434.     MOVE.L    (SP)+,TextE-base(BP)    ; put the length at TextE
  435.     MOVE.L    TextH-base(BP),A0    ; get a handle to the scrap data
  436.     MOVE.L    (A0),D0            ; derefrence the scrap handle
  437.     MOVE.L    D0,TextO-base(BP)    ; set TextO to start of scrap data
  438.     ADD.L    D0,TextE-base(BP)    ; set TextE to end of scrap data
  439.     _HLock                ; don't let data move during paste
  440.     CLR    fsptr-base(BP)
  441.     MOVE.L    TextH-base(BP),fstack-base(BP)
  442.     MOVE.L    TextO-base(BP),fofsets-base(BP)
  443.     MOVE.L    TextE-base(BP),fends-base(BP)
  444.     go:    CLR.B    fint-base(BP)        ; leave keyboard mode
  445.     JMP    CRet-base(BP)        ; get next line
  446.  
  447. Pasting:    ; GetInput comes here for input when fint-base(BP) is 0
  448.     JSR    ClearTermBuf-base(BP)
  449.     CLR.L    D1            ; clear the character count
  450.     CLR.L    D0            ; and the character
  451.     MOVE.L    TextO-base(BP),A0    ; set the input address
  452.     @0:    MOVE.B    0(A0,D1.W),D0        ; BEGIN  get a character
  453.     cmp.b    #9,d0            ; skip over tabs
  454.     bne.s    @1            ; by substituting spaces
  455.     moveq    #bl,d0            ; in the input stream
  456.     @1:    CMP.B    #CR,D0            ;     is it not a CR?
  457.     BEQ.S    @2
  458.     CMPI.B    #78,D1            ;     or 78 characters in buffer
  459.     BGE.S    @2            ; WHILE
  460.         MOVE.B    D0,0(IS,D1)        ;     stash it into buffer
  461.     ADDQ.B    #1,D1            ;     increment count
  462.     BRA.S    @0            ; REPEAT
  463.     @2:    ADDQ.B    #1,D1            ; increment count
  464.     MOVE.B    #CR,0(IS,D1)        ; stash CR into buffer
  465.     MOVE    D1,-(PS)        ; preserve count for TYPE
  466.     ADD.L    TextO-base(BP),D1
  467.     MOVE.L    D1,TextO-base(BP)
  468.     CMP.L    TextE-base(BP),D1    ; IS the block done (TextO>TextE)?
  469.     BMI.S    tandr            ; just type and return if not.
  470.     MOVE    fsptr-base(BP),D0
  471.     LEA    fstack-base(BP),A0
  472.     MOVE.L    0(A0,D0.W),A0
  473.     _HUnlock            ; unlock the block
  474.     BMI    huh
  475.     CMPA.L    TextH-base(BP),A0
  476.     BEQ.S    @3            ; keep the scrap block
  477.     _DisposHandle            ; dispose of loaded blocks
  478.     BMI    huh
  479.  
  480.     @3:    SUBQ    #4,fsptr-base(BP)    ; pop fstack
  481.     BMI.S    @4            ; branch if no pending loads
  482.  
  483.     MOVE    fsptr-base(BP),D0
  484.     LEA    fofsets-base(BP),A0    ; set TextO to (fofsets+fsptr)
  485.     MOVE.L    0(A0,D0.W),TextO-base(BP)
  486.     LEA    fends-base(BP),A0
  487.     MOVE.L    0(A0,D0.W),TextE-base(BP)
  488.     BRA.S    tandr
  489.  
  490.     @4:    BSET.B    #7,fint-base(BP)    ; set keyboard mode
  491.  tandr:    TST    echo-base(BP)
  492.     BNE.S    @5
  493.     JMP    drop-base(BP)
  494.     @5:    MOVE    #termbuf-base,-(PS)
  495.     JSR    swapp-base(BP)
  496.     JSR    type-base(BP)
  497.     JMP    doCR-base(BP)        ; TIB count TYPE CR ;
  498.